home *** CD-ROM | disk | FTP | other *** search
/ QRZ! Ham Radio 8 / QRZ Ham Radio Callsign Database - Volume 8.iso / pc / files / ant_nec / nec81tar.z / nec81tar / etmns.f < prev    next >
Text File  |  1991-05-13  |  11KB  |  412 lines
  1. C $TITLE: 'ETMNS'
  2. C $NOFLOATCALLS
  3.       SUBROUTINE ETMNS(E,ZARRAY,X,Y,Z,BI,SALP,T1X,T1Y,T1Z,T2X,T2Y,
  4.      1 T2Z,P1,P2,P3,P4,P5,P6,ICON1,ICON2,LD,LD2,LD3,IPR)
  5. C
  6. C     ETMNS FILLS THE ARRAY E WITH THE NEGATIVE OF THE ELECTRIC FIELD
  7. C     INCIDENT ON THE STRUCTURE.  E IS THE RIGHT HAND SIDE OF THE MATRIX
  8. C     EQUATION.
  9. C
  10.       REAL*8 TP,RETA,STH,CTH,ARG,SET,CET,SA,CA,WX,WY,WZ
  11. CLARGE: E
  12.       COMPLEX E
  13.       COMPLEX*16 CX,CY,CZ,ER,ET,EZH,ERH,RRV,RRH,TT1,TT2
  14.       COMPLEX*16 ZRATI,ZRATI2,T1,FRATI
  15.       COMPLEX*16 ZARRAY,CDUM,VSANT,VQD,VQDS
  16.       INTEGER*4 ICON1,ICON2,N1,N2,N,NP,M1,M2,M,MP,IPSYM,IS,NEQ
  17.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  18.       COMMON/VSORC/ VQD(30),VSANT(30),VQDS(30),IVQD(30),ISANT(30),
  19.      1 IQDS(30),NVQD,NSANT,NQDS
  20.       COMMON/GND/ZRATI,ZRATI2,FRATI,CL,CH,SCRWL,SCRWR,NRADL,KSYMP,IFAR,
  21.      1IPERF,T1,T2
  22.       DIMENSION E(LD3),ZARRAY(LD),ICON1(LD),ICON2(LD)
  23.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  24.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  25.       DATA TP/6.283185308D0/,RETA/2.654420938D-3/
  26. C**
  27. C     D      WRITE(*,*) '  ETMNS: START'
  28.       LD2=LD2
  29. C**
  30.       NEQ=N+2*M
  31.       NQDS=0
  32.       IF (IPR.GT.0.AND.IPR.NE.5) GO TO 5
  33. C
  34. C     APPLIED FIELD OF VOLTAGE SOURCES FOR TRANSMITTING CASE
  35. C
  36.       DO 1 I=1,NEQ
  37. 1     E(I)=(0.,0.)
  38.       IF (NSANT.EQ.0) GO TO 3
  39.       DO 2 I=1,NSANT
  40.       IS=ISANT(I)
  41.       E(IS)=-VSANT(I)/(T1X(IS)*WLAM)
  42. 2      CONTINUE
  43. 3     IF (NVQD.EQ.0) RETURN
  44.       DO 4 I=1,NVQD
  45.       IS=IVQD(I)
  46.       CDUM=VQD(I)
  47.       CALL QDSRC(E,ZARRAY,CDUM,X,Y,Z,BI,SALP,T1X,T1Y,
  48.      1 T1Z,T2X,T2Y,T2Z,ICON1,ICON2,IS,LD,LD3)
  49. 4      CONTINUE
  50.       RETURN
  51. 5     IF (IPR.GT.3) GO TO 19
  52. C
  53. C     INCIDENT PLANE WAVE, LINEARLY POLARIZED.
  54. C
  55. C      CTH=DCOS(P1)
  56. C      STH=DSIN(P1)
  57. C      CPH=DCOS(P2)
  58. C      SPH=DSIN(P2)
  59. C      CET=DCOS(P3)
  60. C      SET=DSIN(P3)
  61.       CTH=COS(P1)
  62.       STH=SIN(P1)
  63.       CPH=COS(P2)
  64.       SPH=SIN(P2)
  65.       CET=COS(P3)
  66.       SET=SIN(P3)
  67.       PX=CTH*CPH*CET-SPH*SET
  68.       PY=CTH*SPH*CET+CPH*SET
  69.       PZ=-STH*CET
  70.       WX=-STH*CPH
  71.       WY=-STH*SPH
  72.       WZ=-CTH
  73.       QX=WY*PZ-WZ*PY
  74.       QY=WZ*PX-WX*PZ
  75.       QZ=WX*PY-WY*PX
  76.       IF (KSYMP.EQ.1) GO TO 7
  77.       IF (IPERF.EQ.1) GO TO 6
  78. C      RRV=CSQRT(1.-ZRATI*ZRATI*STH*STH)
  79.       RRV=ZSQRT(1.-ZRATI*ZRATI*STH*STH)
  80.       RRH=ZRATI*CTH
  81.       RRH=(RRH-RRV)/(RRH+RRV)
  82.       RRV=ZRATI*RRV
  83.       RRV=-(CTH-RRV)/(CTH+RRV)
  84.       GO TO 7
  85. 6     RRV=-(1.,0.)
  86.       RRH=-(1.,0.)
  87. 7     IF (IPR.GT.1) GO TO 13
  88.       IF (N.EQ.0) GO TO 10
  89.       DO 8 I=1,N
  90.       ARG=-TP*(WX*X(I)+WY*Y(I)+WZ*Z(I))
  91.       CA=DCOS(ARG)
  92.       SA=DSIN(ARG)
  93. 8     E(I)=-(PX*T1Y(I)+PY*T1Z(I)+PZ*SALP(I))*DCMPLX(CA,SA)
  94.       IF (KSYMP.EQ.1) GO TO 10
  95.       TT1=(PY*CPH-PX*SPH)*(RRH-RRV)
  96.       CX=RRV*PX-TT1*SPH
  97.       CY=RRV*PY+TT1*CPH
  98.       CZ=-RRV*PZ
  99.       DO 9 I=1,N
  100.       ARG=-TP*(WX*X(I)+WY*Y(I)-WZ*Z(I))
  101.       CA=DCOS(ARG)
  102.       SA=DSIN(ARG)
  103. 9     E(I)=E(I)-(CX*T1Y(I)+CY*T1Z(I)+CZ*SALP(I))*DCMPLX(CA,SA)
  104. 10    IF (M.EQ.0) RETURN
  105.       I=LD+1
  106.       I1=N-1
  107.       DO 11 IS=1,M
  108.       I=I-1
  109.       I1=I1+2
  110.       I2=I1+1
  111.       ARG=-TP*(WX*X(I)+WY*Y(I)+WZ*Z(I))
  112.       CA=DCOS(ARG)
  113.       SA=DSIN(ARG)
  114.       TT1=DCMPLX(CA,SA)*SALP(I)*RETA
  115.       E(I2)=(QX*T1X(I)+QY*T1Y(I)+QZ*T1Z(I))*TT1
  116. 11    E(I1)=(QX*T2X(I)+QY*T2Y(I)+QZ*T2Z(I))*TT1
  117.       IF (KSYMP.EQ.1) RETURN
  118.       TT1=(QY*CPH-QX*SPH)*(RRV-RRH)
  119.       CX=-(RRH*QX-TT1*SPH)
  120.       CY=-(RRH*QY+TT1*CPH)
  121.       CZ=RRH*QZ
  122.       I=LD+1
  123.       I1=N-1
  124.       DO 12 IS=1,M
  125.       I=I-1
  126.       I1=I1+2
  127.       I2=I1+1
  128.       ARG=-TP*(WX*X(I)+WY*Y(I)-WZ*Z(I))
  129.       CA=DCOS(ARG)
  130.       SA=DSIN(ARG)
  131.       TT1=DCMPLX(CA,SA)*SALP(I)*RETA
  132.       E(I2)=E(I2)+(CX*T1X(I)+CY*T1Y(I)+CZ*T1Z(I))*TT1
  133. 12    E(I1)=E(I1)+(CX*T2X(I)+CY*T2Y(I)+CZ*T2Z(I))*TT1
  134.       RETURN
  135. C
  136. C     INCIDENT PLANE WAVE, ELLIPTIC POLARIZATION.
  137. C
  138. 13    TT1=-(0.,1.)*P6
  139.       IF (IPR.EQ.3) TT1=-TT1
  140.       IF (N.EQ.0) GO TO 16
  141.       CX=PX+TT1*QX
  142.       CY=PY+TT1*QY
  143.       CZ=PZ+TT1*QZ
  144.       DO 14 I=1,N
  145.       ARG=-TP*(WX*X(I)+WY*Y(I)+WZ*Z(I))
  146.       CA=DCOS(ARG)
  147.       SA=DSIN(ARG)
  148. 14    E(I)=-(CX*T1Y(I)+CY*T1Z(I)+CZ*SALP(I))*DCMPLX(CA,SA)
  149.       IF (KSYMP.EQ.1) GO TO 16
  150.       TT2=(CY*CPH-CX*SPH)*(RRH-RRV)
  151.       CX=RRV*CX-TT2*SPH
  152.       CY=RRV*CY+TT2*CPH
  153.       CZ=-RRV*CZ
  154.       DO 15 I=1,N
  155.       ARG=-TP*(WX*X(I)+WY*Y(I)-WZ*Z(I))
  156.       CA=DCOS(ARG)
  157.       SA=DSIN(ARG)
  158. 15    E(I)=E(I)-(CX*T1Y(I)+CY*T1Z(I)+CZ*SALP(I))*DCMPLX(CA,SA)
  159. 16    IF (M.EQ.0) RETURN
  160.       CX=QX-TT1*PX
  161.       CY=QY-TT1*PY
  162.       CZ=QZ-TT1*PZ
  163.       I=LD+1
  164.       I1=N-1
  165.       DO 17 IS=1,M
  166.       I=I-1
  167.       I1=I1+2
  168.       I2=I1+1
  169.       ARG=-TP*(WX*X(I)+WY*Y(I)+WZ*Z(I))
  170.       CA=DCOS(ARG)
  171.       SA=DSIN(ARG)
  172.       TT2=DCMPLX(CA,SA)*SALP(I)*RETA
  173.       E(I2)=(CX*T1X(I)+CY*T1Y(I)+CZ*T1Z(I))*TT2
  174. 17    E(I1)=(CX*T2X(I)+CY*T2Y(I)+CZ*T2Z(I))*TT2
  175.       IF (KSYMP.EQ.1) RETURN
  176.       TT1=(CY*CPH-CX*SPH)*(RRV-RRH)
  177.       CX=-(RRH*CX-TT1*SPH)
  178.       CY=-(RRH*CY+TT1*CPH)
  179.       CZ=RRH*CZ
  180.       I=LD+1
  181.       I1=N-1
  182.       DO 18 IS=1,M
  183.       I=I-1
  184.       I1=I1+2
  185.       I2=I1+1
  186.       ARG=-TP*(WX*X(I)+WY*Y(I)-WZ*Z(I))
  187.       CA=DCOS(ARG)
  188.       SA=DSIN(ARG)
  189.       TT1=DCMPLX(CA,SA)*SALP(I)*RETA
  190.       E(I2)=E(I2)+(CX*T1X(I)+CY*T1Y(I)+CZ*T1Z(I))*TT1
  191. 18    E(I1)=E(I1)+(CX*T2X(I)+CY*T2Y(I)+CZ*T2Z(I))*TT1
  192. C**
  193. C     D      WRITE(*,*) '  ETMNS: RETURN AFTER 18'
  194. C**
  195.       RETURN
  196. C
  197. C     INCIDENT FIELD OF AN ELEMENTARY CURRENT SOURCE.
  198. C
  199. C19    WZ=DCOS(P4)
  200. C      WX=WZ*DCOS(P5)
  201. C      WY=WZ*DSIN(P5)
  202. C      WZ=DSIN(P4)
  203. 19    WZ=COS(P4)
  204.       WX=WZ*COS(P5)
  205.       WY=WZ*SIN(P5)
  206.       WZ=SIN(P4)
  207.       DS=P6*59.958
  208.       DSH=P6/(2.*TP)
  209.       NPM=N+M
  210.       IS=LD+1
  211.       I1=N-1
  212.       DO 24 I=1,NPM
  213.       II=I
  214.       IF (I.LE.N) GO TO 20
  215.       IS=IS-1
  216.       II=IS
  217.       I1=I1+2
  218.       I2=I1+1
  219. 20    PX=X(II)-P1
  220.       PY=Y(II)-P2
  221.       PZ=Z(II)-P3
  222.       RS=PX*PX+PY*PY+PZ*PZ
  223.       IF (RS.LT.1.E-30) GO TO 24
  224.       R=SQRT(RS)
  225.       PX=PX/R
  226.       PY=PY/R
  227.       PZ=PZ/R
  228.       CTH=PX*WX+PY*WY+PZ*WZ
  229.       STH=SQRT(1.-CTH*CTH)
  230.       QX=PX-WX*CTH
  231.       QY=PY-WY*CTH
  232.       QZ=PZ-WZ*CTH
  233.       ARG=SQRT(QX*QX+QY*QY+QZ*QZ)
  234.       IF (ARG.LT.1.E-30) GO TO 21
  235.       QX=QX/ARG
  236.       QY=QY/ARG
  237.       QZ=QZ/ARG
  238.       GO TO 22
  239. 21    QX=1.
  240.       QY=0.
  241.       QZ=0.
  242. 22    ARG=-TP*R
  243.       CA=DCOS(ARG)
  244.       SA=DSIN(ARG)
  245.       TT1=DCMPLX(CA,SA)
  246.       IF (I.GT.N) GO TO 23
  247.       TT2=DCMPLX(1.,-1./(R*TP))/RS
  248.       ER=DS*TT1*TT2*CTH
  249.       ET=.5*DS*TT1*((0.,1.)*TP/R+TT2)*STH
  250.       EZH=ER*CTH-ET*STH
  251.       ERH=ER*STH+ET*CTH
  252.       CX=EZH*WX+ERH*QX
  253.       CY=EZH*WY+ERH*QY
  254.       CZ=EZH*WZ+ERH*QZ
  255.       E(I)=-(CX*T1Y(I)+CY*T1Z(I)+CZ*SALP(I))
  256.       GO TO 24
  257. 23    PX=WY*QZ-WZ*QY
  258.       PY=WZ*QX-WX*QZ
  259.       PZ=WX*QY-WY*QX
  260.       TT2=DSH*TT1*DCMPLX(1./R,TP)/R*STH*SALP(II)
  261.       CX=TT2*PX
  262.       CY=TT2*PY
  263.       CZ=TT2*PZ
  264.       E(I2)=CX*T1X(II)+CY*T1Y(II)+CZ*T1Z(II)
  265.       E(I1)=CX*T2X(II)+CY*T2Y(II)+CZ*T2Z(II)
  266. 24    CONTINUE
  267. C**
  268. C     D      WRITE(*,*) '  ETMNS: RETURN AT END'
  269. C**
  270.       RETURN
  271.       END
  272. C
  273. C
  274. C
  275.       SUBROUTINE QDSRC(E,ZARRAY,V,X,Y,Z,BI,SALP,T1X,T1Y,
  276.      1 T1Z,T2X,T2Y,T2Z,ICON1,ICON2,IS,LD,LD3)
  277.       REAL*8 TP,CCJX,XI,YI,ZI
  278. C  FILL INCIDENT FIELD ARRAY FOR CHARGE DISCONTINUITY VOLTAGE SOURCE
  279.       REAL*8 AX,BX,CX
  280. CLARGE: E
  281.       COMPLEX E
  282.       COMPLEX*16 CCJ
  283.       COMPLEX*16 CURD,EXK,EYK,EZK,EXS,EYS,EZS,EXC,EYC,EZC,ETK,ETS,ETC
  284.       COMPLEX*16 VQDS,V,VSANT,VQD,ZARRAY
  285.       INTEGER*4 ICON1,ICON2,N1,N2,N,NP,M1,M2,M,MP,IPSYM,IS,IND1,IND2
  286.       COMMON/DATAD/N1,N2,N,NP,M1,M2,M,MP,IPSYM,WLAM
  287.       COMMON/VSORC/ VQD(30),VSANT(30),VQDS(30),IVQD(30),ISANT(30),
  288.      1 IQDS(30),NVQD,NSANT,NQDS
  289.       COMMON/SEGJ/AX(30),BX(30),CX(30),JCO(30),JSNO,ISCON(50),NSCON,
  290.      1 IPCON(10),NPCON
  291.       COMMON/DATAJ/S,B,XJ,YJ,ZJ,CABJ,SABJ,SALPJ,EXK,EYK,EZK,EXS,EYS,
  292.      1 EZS,EXC,EYC,EZC,RKH,IND1,IND2,IPGND,IEXK
  293.       COMMON/ZLOAD/ NLOAD,NLODF
  294.       DIMENSION X(LD),Y(LD),Z(LD),BI(LD),SALP(LD)
  295.       DIMENSION E(LD3),ZARRAY(LD),ICON1(LD),ICON2(LD),CCJX(2)
  296.       DIMENSION T1X(LD),T1Y(LD),T1Z(LD),T2X(LD),T2Y(LD),T2Z(LD)
  297.       EQUIVALENCE (CCJ,CCJX)
  298.       DATA TP/6.283185308D0/,CCJX/0.,-.01666666667D0/
  299. C**
  300. C     D      WRITE(*,*) '   QDSRC: START'
  301. C**
  302.       I=ICON1(IS)
  303.       ICON1(IS)=0
  304.       IDM1=0
  305.       IDM2=IS
  306.       CALL TBF(T1X,BI,ICON1,ICON2,IDM1,IDM2,LD)
  307.       ICON1(IS)=I
  308.       S=T1X(IS)*.5
  309. C      CURD=CCJ*V/((DLOG(2.*S/BI(IS))-1.)*(BX(JSNO)*DCOS(TP*S)+CX(JSNO)
  310.       CURD=CCJ*V/((LOG(2.*S/BI(IS))-1.)*(BX(JSNO)*DCOS(TP*S)+CX(JSNO)
  311.      1*SIN(TP*S))*WLAM)
  312. C     1*DSIN(TP*S))*WLAM)
  313.       NQDS=NQDS+1
  314.       VQDS(NQDS)=V
  315.       IQDS(NQDS)=IS
  316.       DO 20 JX=1,JSNO
  317.       J=JCO(JX)
  318.       S=T1X(J)
  319.       B=BI(J)
  320.       XJ=X(J)
  321.       YJ=Y(J)
  322.       ZJ=Z(J)
  323.       CABJ=T1Y(J)
  324.       SABJ=T1Z(J)
  325.       SALPJ=SALP(J)
  326.       IF (IEXK.EQ.0) GO TO 16
  327.       IPR=ICON1(J)
  328.       IF (IPR) 1,6,2
  329. 1     IPR=-IPR
  330.       IF (-ICON1(IPR).NE.J) GO TO 7
  331.       GO TO 4
  332. 2     IF (IPR.NE.J) GO TO 3
  333.       IF (CABJ*CABJ+SABJ*SABJ.GT.1.E-8) GO TO 7
  334.       GO TO 5
  335. 3     IF (ICON2(IPR).NE.J) GO TO 7
  336. 4     XI=ABS(CABJ*T1Y(IPR)+SABJ*T1Z(IPR)+SALPJ*SALP(IPR))
  337.       IF (XI.LT.0.999999) GO TO 7
  338.       IF (ABS(BI(IPR)/B-1.).GT.1.E-6) GO TO 7
  339. 5     IND1=0
  340.       GO TO 8
  341. 6     IND1=1
  342.       GO TO 8
  343. 7     IND1=2
  344. 8     IPR=ICON2(J)
  345.       IF (IPR) 9,14,10
  346. 9     IPR=-IPR
  347.       IF (-ICON2(IPR).NE.J) GO TO 15
  348.       GO TO 12
  349. 10    IF (IPR.NE.J) GO TO 11
  350.       IF (CABJ*CABJ+SABJ*SABJ.GT.1.E-8) GO TO 15
  351.       GO TO 13
  352. 11    IF (ICON1(IPR).NE.J) GO TO 15
  353. 12    XI=ABS(CABJ*T1Y(IPR)+SABJ*T1Z(IPR)+SALPJ*SALP(IPR))
  354.       IF (XI.LT.0.999999) GO TO 15
  355.       IF (ABS(BI(IPR)/B-1.).GT.1.E-6) GO TO 15
  356. 13    IND2=0
  357.       GO TO 16
  358. 14    IND2=1
  359.       GO TO 16
  360. 15    IND2=2
  361. 16    CONTINUE
  362.       DO 17 I=1,N
  363.       IJ=I-J
  364.       XI=X(I)
  365.       YI=Y(I)
  366.       ZI=Z(I)
  367.       AI=BI(I)
  368.       CALL EFLD (XI,YI,ZI,AI,IJ)
  369.       CABI=T1Y(I)
  370.       SABI=T1Z(I)
  371.       SALPI=SALP(I)
  372.       ETK=EXK*CABI+EYK*SABI+EZK*SALPI
  373.       ETS=EXS*CABI+EYS*SABI+EZS*SALPI
  374.       ETC=EXC*CABI+EYC*SABI+EZC*SALPI
  375. 17    E(I)=E(I)-(ETK*AX(JX)+ETS*BX(JX)+ETC*CX(JX))*CURD
  376.       IF (M.EQ.0) GO TO 19
  377.       IJ=LD+1
  378.       I1=N
  379.       DO 18 I=1,M
  380.       IJ=IJ-1
  381.       XI=X(IJ)
  382.       YI=Y(IJ)
  383.       ZI=Z(IJ)
  384.       CALL HSFLD (XI,YI,ZI,0.)
  385.       I1=I1+1
  386.       TX=T2X(IJ)
  387.       TY=T2Y(IJ)
  388.       TZ=T2Z(IJ)
  389.       ETK=EXK*TX+EYK*TY+EZK*TZ
  390.       ETS=EXS*TX+EYS*TY+EZS*TZ
  391.       ETC=EXC*TX+EYC*TY+EZC*TZ
  392.       E(I1)=E(I1)+(ETK*AX(JX)+ETS*BX(JX)+ETC*CX(JX))*CURD*SALP(IJ)
  393.       I1=I1+1
  394.       TX=T1X(IJ)
  395.       TY=T1Y(IJ)
  396.       TZ=T1Z(IJ)
  397.       ETK=EXK*TX+EYK*TY+EZK*TZ
  398.       ETS=EXS*TX+EYS*TY+EZS*TZ
  399.       ETC=EXC*TX+EYC*TY+EZC*TZ
  400. 18    E(I1)=E(I1)+(ETK*AX(JX)+ETS*BX(JX)+ETC*CX(JX))*CURD*SALP(IJ)
  401. C***
  402. C***    LLNL FIX FM GJB - ADD "*XKU" AT END OF LINE  RWA 03 APR 89
  403. C***
  404. 19    IF(NLOAD.GT.0.OR.NLODF.GT.0) E(J)=E(J)+ZARRAY(J)*CURD*(AX(JX)+
  405.      1 CX(JX))*XKU
  406. 20    CONTINUE
  407. C**
  408. C D      WRITE(*,*) '   QDSRC: RETURN'
  409. C**
  410.       RETURN
  411.       END
  412.